home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / octa209s.zip / octave-2.09 / libcruft / ranlib / ignuin.f < prev    next >
Text File  |  1997-05-26  |  3KB  |  105 lines
  1.       INTEGER FUNCTION ignuin(low,high)
  2. C**********************************************************************
  3. C
  4. C     INTEGER FUNCTION IGNUIN( LOW, HIGH )
  5. C
  6. C               GeNerate Uniform INteger
  7. C
  8. C
  9. C                              Function
  10. C
  11. C
  12. C     Generates an integer uniformly distributed between LOW and HIGH.
  13. C
  14. C
  15. C                              Arguments
  16. C
  17. C
  18. C     LOW --> Low bound (inclusive) on integer value to be generated
  19. C                         INTEGER LOW
  20. C
  21. C     HIGH --> High bound (inclusive) on integer value to be generated
  22. C                         INTEGER HIGH
  23. C
  24. C
  25. C                              Note
  26. C
  27. C
  28. C     If (HIGH-LOW) > 2,147,483,561 prints error message on * unit and
  29. C     stops the program.
  30. C
  31. C**********************************************************************
  32.  
  33. C     IGNLGI generates integers between 1 and 2147483562
  34. C     MAXNUM is 1 less than maximum generable value
  35. C     .. Parameters ..
  36.       INTEGER maxnum
  37.       PARAMETER (maxnum=2147483561)
  38.       CHARACTER*(*) err1,err2
  39.       PARAMETER (err1='LOW > HIGH in IGNUIN',
  40.      +          err2=' ( HIGH - LOW ) > 2,147,483,561 in IGNUIN')
  41. C     ..
  42. C     .. Scalar Arguments ..
  43.       INTEGER high,low
  44. C     ..
  45. C     .. Local Scalars ..
  46.       INTEGER err,ign,maxnow,range,ranp1
  47. C     ..
  48. C     .. External Functions ..
  49.       INTEGER ignlgi
  50.       EXTERNAL ignlgi
  51. C     ..
  52. C     .. Intrinsic Functions ..
  53.       INTRINSIC mod
  54. C     ..
  55. C     .. Executable Statements ..
  56.       IF (.NOT. (low.GT.high)) GO TO 10
  57.       err = 1
  58. C      ABORT-PROGRAM
  59.       GO TO 80
  60.  
  61.    10 range = high - low
  62.       IF (.NOT. (range.GT.maxnum)) GO TO 20
  63.       err = 2
  64. C      ABORT-PROGRAM
  65.       GO TO 80
  66.  
  67.    20 IF (.NOT. (low.EQ.high)) GO TO 30
  68.       ignuin = low
  69.       RETURN
  70.  
  71.       GO TO 70
  72.  
  73. C     Number to be generated should be in range 0..RANGE
  74. C     Set MAXNOW so that the number of integers in 0..MAXNOW is an
  75. C     integral multiple of the number in 0..RANGE
  76.  
  77.    30 ranp1 = range + 1
  78.       maxnow = (maxnum/ranp1)*ranp1
  79.    40 ign = ignlgi() - 1
  80.       IF (.NOT. (ign.LE.maxnow)) GO TO 50
  81.       ignuin = low + mod(ign,ranp1)
  82.       RETURN
  83.  
  84.    50 GO TO 40
  85.  
  86.    60 CONTINUE
  87.    70 CONTINUE
  88.    80 IF (.NOT. (err.EQ.1)) GO TO 90
  89.       WRITE (*,*) err1
  90.       GO TO 100
  91.  
  92. C     TO ABORT-PROGRAM
  93.    90 WRITE (*,*) err2
  94.   100 WRITE (*,*) ' LOW: ',low,' HIGH: ',high
  95.       WRITE (*,*) ' Abort on Fatal ERROR'
  96.       IF (.NOT. (err.EQ.1)) GO TO 110
  97.       CALL XSTOPX ('LOW > HIGH in IGNUIN')
  98.       IGNUIN = 0
  99.  
  100.       GO TO 120
  101.  
  102.   110 STOP ' ( HIGH - LOW ) > 2,147,483,561 in IGNUIN'
  103.  
  104.   120 END
  105.